library(jsonlite)
library(chron)
library(ggplot2)
library(naniar)
library(plotly)
Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     
Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

Attaching package: ‘plotly’

The following object is masked from ‘package:ggplot2’:

    last_plot

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout
library(ggplot2)
library(dplyr) # easier data wrangling 

Attaching package: ‘dplyr’

The following objects are masked from ‘package:stats’:

    filter, lag

The following objects are masked from ‘package:base’:

    intersect, setdiff, setequal, union
library(viridis) # colour blind friendly palette, works in B&W also
Loading required package: viridisLite
library(Interpol.T) #  will generate a large dataset on initial load
Loading required package: date
library(lubridate) # for easy date manipulation

Attaching package: ‘lubridate’

The following objects are masked from ‘package:chron’:

    days, hours, minutes, seconds, years

The following objects are masked from ‘package:base’:

    date, intersect, setdiff, union
library(ggExtra) # because remembering ggplot theme options is beyond me

Read station meta data

station_meta_data = read_json('station_meta_data.json', simplifyVector = TRUE)
#View(station_meta_data)
  # data <- stream_in(file("dataNDJSON.json"),pagesize = 10)
  # flat_data <- flatten(data, recursive = TRUE)

Generate list of station data frames and include meta data

NETWORK <- "FLNRO-WMB"

all_headers <- c("wind_direction", "rel_hum", "avg_wnd_spd_10m_pst10mts", "precipitation", "dwpt_temp", "wind_speed", "air_temp", "temperature", "rnfl_amt_pst1hr", "avg_wnd_dir_10m_pst10mts", "rnfl_amt_pst24hrs", "relative_humidity", "time", "snw_dpth", "network_name", "native_id", "station_name", "lon", "lat", "elev", "min_obs_time", "max_obs_time", "freq", "province", "station_id", "history_id", "description", "network_id", "col_hex","vars","display_names")     

stationFiles <- list.files(path=NETWORK, pattern="*.ascii", full.names=FALSE, recursive=FALSE)

list_of_station_df <- lapply(stationFiles, function(fileName) {
  
  station_df <- read.csv(file = paste(NETWORK, fileName, sep="/"), sep=',', strip.white=TRUE, skip = 1)
  station_id <- gsub("*.ascii", "", fileName)
  
  station_meta_data_headers = names(station_meta_data[[station_id]])
  
  
  # Add meta data to every row in station_df
  for(header in station_meta_data_headers) {
    station_df[,header] <- c(rep(station_meta_data[[station_id]][[header]], nrow(station_df)))

  }
  
  # Add headers if they don't exist, so all df's have same headers
  station_df[all_headers[!(all_headers %in% colnames(station_df))]] = NA
  
  # Delete useless columns
  station_df$display_names <- NULL
  station_df$vars <- NULL

  # Convert these columns to numeric type
  station_df$wind_direction = as.numeric(station_df$wind_direction)
  station_df$rel_hum = as.numeric(station_df$rel_hum)
  station_df$precipitation = as.numeric(station_df$precipitation)
  station_df$wind_speed = as.numeric(station_df$wind_speed)
  station_df$temperature = as.numeric(station_df$temperature)
  station_df$avg_wnd_dir_10m_pst10mts = as.numeric(station_df$avg_wnd_dir_10m_pst10mts)
  station_df$relative_humidity = as.numeric(station_df$relative_humidity)
  station_df$snw_dpth = as.numeric(station_df$snw_dpth)
  station_df$lon = as.numeric(station_df$lon)
  station_df$lat = as.numeric(station_df$lat)
  station_df$elev = as.numeric(station_df$elev)
  station_df$air_temp = as.numeric(station_df$air_temp)
  station_df$dwpt_temp = as.numeric(station_df$dwpt_temp)
  station_df$freq = as.numeric(station_df$freq)
  station_df$rnfl_amt_pst24hrs = as.numeric(station_df$rnfl_amt_pst24hrs)
  # tation_df$time = as.POSIXct(station_df$time)
  
  
  return(station_df)
})

Confirm data types are appropriate

# Check types of all columns in a data frame
sapply(list_of_station_df[[67]], mode)
          wind_direction                  rel_hum avg_wnd_spd_10m_pst10mts            precipitation 
               "numeric"                "numeric"              "character"                "numeric" 
               dwpt_temp               wind_speed                 air_temp              temperature 
               "numeric"                "numeric"                "numeric"                "numeric" 
         rnfl_amt_pst1hr avg_wnd_dir_10m_pst10mts        rnfl_amt_pst24hrs        relative_humidity 
             "character"                "numeric"                "numeric"                "numeric" 
                    time                 snw_dpth             network_name                native_id 
             "character"                "numeric"              "character"              "character" 
            station_name                      lon                      lat                     elev 
             "character"                "numeric"                "numeric"                "numeric" 
            min_obs_time             max_obs_time                     freq                 province 
             "character"              "character"                "numeric"              "character" 
              station_id               history_id              description               network_id 
               "numeric"                "numeric"              "character"                "numeric" 
                 col_hex 
             "character" 

Inspect a single weather station


# Get the 1st df (for example..)
df_1 = list_of_station_df[[1]]

Visualize missing data for relevent variables

df_1_relevant = df_1[, c("wind_speed", "rel_hum", "precipitation", "relative_humidity", "wind_direction", "temperature", "air_temp", "time")]

gg_miss_var(df_1_relevant)

Heat Map


# Create df for heat map
df_heatmap <- data.frame(matrix(ncol = 0, nrow = nrow(df_1)))
df_heatmap$stationid <- df_1$station_id
df_heatmap$day <- day(as.POSIXct(df_1$time))
df_heatmap$hour <- hour(as.POSIXct(df_1$time))
df_heatmap$month <- month(as.POSIXct(df_1$time))
df_heatmap$year <- year(as.POSIXct(df_1$time))
df_heatmap$temp <- df_1$temperature

#sapply(df_heatmap, mode)

# Only use rows for year 2020
df_heatmap <- df_heatmap[df_heatmap$year == 2020,]


# Look into more specialist way of replacing these missing values -e.g. imputation or IDW interpolation
 
df <- df_heatmap

statno <-unique(df$stationid)
 
######## Plotting starts here#####################
p <-ggplot(df,aes(day,hour,fill=temp))+
  geom_tile(color= "white",size=0.1) + 
  scale_fill_viridis(name="Hrly Temps C",option ="C")
p <-p + facet_grid(year~month)
p <-p + scale_y_continuous(trans = "reverse", breaks = unique(df$hour))
p <-p + scale_x_continuous(breaks =c(1,10,20,31))
p <-p + theme_minimal(base_size = 8)
p <-p + labs(title= paste("Hourly Temps - Station",statno), x="Day", y="Hour Commencing")
p <-p + theme(legend.position = "bottom")+
  theme(plot.title=element_text(size = 14))+
  theme(axis.text.y=element_text(size=6)) +
  theme(strip.background = element_rect(colour="white"))+
  theme(plot.title=element_text(hjust=0))+
  theme(axis.ticks=element_blank())+
  theme(axis.text=element_text(size=7))+
  theme(legend.title=element_text(size=8))+
  theme(legend.text=element_text(size=6))+
  removeGrid()#ggExtra
 
# you will want to expand your plot screen before this bit!
p #awesomeness

Time Series

temp_df_1 <- data.frame(
  day = as.POSIXct(df_1$time),
  value = df_1$temperature
)

rel_hum_df_1 <- data.frame(
  day = as.POSIXct(df_1$time),
  value = df_1$relative_humidity
)

precip_df_1 <- data.frame(
  day = as.POSIXct(df_1$time),
  value = df_1$precipitation
)
# Libraries
library(ggplot2)
library(dplyr)
library(hrbrthemes)
NOTE: Either Arial Narrow or Roboto Condensed fonts are required to use these themes.
      Please use hrbrthemes::import_roboto_condensed() to install Roboto Condensed and
      if Arial Narrow is not on your system, please see https://bit.ly/arialnarrow
# # Dummy data
# data <- data.frame(
#   day = df_1$time,
#   value = df_1$temperature
# )

createTimeSeries <- function (data, y_lab) {

  # Most  plot
  p <- ggplot(data, aes(x=day, y=value, group = 1)) +
    geom_line(color="steelblue") +
    geom_smooth(method="auto", se=TRUE, fullrange=FALSE, level=0.95, color="grey") +
    xlab("") +
    ylab(y_lab) +
    theme_ipsum() +
    theme(axis.text.x=element_text(angle=60, hjust=1))
  
  p <- ggplotly(p)
  
  p
}
createTimeSeries(temp_df_1, "Temperature")
`geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
Removed 37 rows containing non-finite values (stat_smooth).
createTimeSeries(rel_hum_df_1, "Relative Humidity")
`geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
Removed 37 rows containing non-finite values (stat_smooth).
createTimeSeries(precip_df_1, "Precipitation")
`geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
Removed 37 rows containing non-finite values (stat_smooth).
# Get min and max rel_hum
max_rel_hum = max(df_1$rel_hum, na.rm = TRUE)
min_rel_hum = min(df_1$rel_hum, na.rm = TRUE)

min_time = min(df_1$time, na.rm = TRUE)
max_time = max(df_1$time, na.rm = TRUE)

# Get the min and max time of all the data
min_time_all = min(unlist(lapply(list_of_station_df, function(df) {
  return(min(df$time, na.rm = TRUE))
})))

max_time_all = max(unlist(lapply(list_of_station_df, function(df) {
  return(max(df$time, na.rm = TRUE))
})))

print(min_time_all)
[1] "2020-01-10 00:00:00"
print(max_time_all)
[1] "2021-01-14 00:00:00"
print(as.POSIXct(min_time_all))
[1] "2020-01-10 PST"
print(as.POSIXct(max_time_all))
[1] "2021-01-14 PST"

Generate list of hours between min and max time

time_range_hours <- seq(as.POSIXct(min_time_all), as.POSIXct(max_time_all), by="hour")
time_range_hours <- lapply(time_range_hours, function(hour) as.POSIXct(hour, format="%d-%b-%Y %H:%M:%OS"))
#print(time_range_hours[1:2])
#print(typeof(time_range_hours[[1]]))
#print(as.character(time_range_hours[[length(time_range_hours)]]))
print(time_range_hours[1:3])
[[1]]
[1] "2020-01-10 PST"

[[2]]
[1] "2020-01-10 01:00:00 PST"

[[3]]
[1] "2020-01-10 02:00:00 PST"

Create list of df’s for every hour

list_of_hourly_station_df = list()

for(time in time_range_hours) {
  df <- data.frame(matrix(ncol = length(all_headers), nrow = 0))
  colnames(df) <- all_headers
  
  list_of_hourly_station_df[[as.character(time)]] = df

}
for(station_df in list_of_station_df[1]) {
  
  for (rowNum in 1:nrow(station_df)) {
  
    time <- as.POSIXct(station_df[rowNum, "time"])
    hour_df = list_of_hourly_station_df[[as.character(time)]]
    
    #list_of_hourly_station_df[[as.character(time)]] = rbind(hour_df, station_df[rowNum,])
    
    hour_df[nrow(hour_df) + 1,] = station_df[rowNum,]    
    list_of_hourly_station_df[[as.character(time)]] = hour_df


  }
}
LS0tCnRpdGxlOiAiV2lsZGZpcmUgVmlzdWFsaXphdGlvbnMgTm90ZWJvb2siCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KCmBgYHtyfQpsaWJyYXJ5KGpzb25saXRlKQpsaWJyYXJ5KGNocm9uKQpsaWJyYXJ5KGdncGxvdDIpCmxpYnJhcnkobmFuaWFyKQpsaWJyYXJ5KHBsb3RseSkKbGlicmFyeShnZ3Bsb3QyKQpsaWJyYXJ5KGRwbHlyKSAjIGVhc2llciBkYXRhIHdyYW5nbGluZyAKbGlicmFyeSh2aXJpZGlzKSAjIGNvbG91ciBibGluZCBmcmllbmRseSBwYWxldHRlLCB3b3JrcyBpbiBCJlcgYWxzbwpsaWJyYXJ5KEludGVycG9sLlQpICMgIHdpbGwgZ2VuZXJhdGUgYSBsYXJnZSBkYXRhc2V0IG9uIGluaXRpYWwgbG9hZApsaWJyYXJ5KGx1YnJpZGF0ZSkgIyBmb3IgZWFzeSBkYXRlIG1hbmlwdWxhdGlvbgpsaWJyYXJ5KGdnRXh0cmEpICMgYmVjYXVzZSByZW1lbWJlcmluZyBnZ3Bsb3QgdGhlbWUgb3B0aW9ucyBpcyBiZXlvbmQgbWUKYGBgCgojIyMgUmVhZCBzdGF0aW9uIG1ldGEgZGF0YQpgYGB7cn0Kc3RhdGlvbl9tZXRhX2RhdGEgPSByZWFkX2pzb24oJ3N0YXRpb25fbWV0YV9kYXRhLmpzb24nLCBzaW1wbGlmeVZlY3RvciA9IFRSVUUpCiNWaWV3KHN0YXRpb25fbWV0YV9kYXRhKQpgYGAKCmBgYHtyfQogICMgZGF0YSA8LSBzdHJlYW1faW4oZmlsZSgiZGF0YU5ESlNPTi5qc29uIikscGFnZXNpemUgPSAxMCkKICAjIGZsYXRfZGF0YSA8LSBmbGF0dGVuKGRhdGEsIHJlY3Vyc2l2ZSA9IFRSVUUpCmBgYAoKCiMjIyBHZW5lcmF0ZSBsaXN0IG9mIHN0YXRpb24gZGF0YSBmcmFtZXMgYW5kIGluY2x1ZGUgbWV0YSBkYXRhCmBgYHtyIGVjaG8gPSBULCByZXN1bHRzID0gJ2hpZGUnLCB3YXJuaW5nPUZBTFNFfQpORVRXT1JLIDwtICJGTE5STy1XTUIiCgphbGxfaGVhZGVycyA8LSBjKCJ3aW5kX2RpcmVjdGlvbiIsICJyZWxfaHVtIiwgImF2Z193bmRfc3BkXzEwbV9wc3QxMG10cyIsICJwcmVjaXBpdGF0aW9uIiwgImR3cHRfdGVtcCIsICJ3aW5kX3NwZWVkIiwgImFpcl90ZW1wIiwgInRlbXBlcmF0dXJlIiwgInJuZmxfYW10X3BzdDFociIsICJhdmdfd25kX2Rpcl8xMG1fcHN0MTBtdHMiLCAicm5mbF9hbXRfcHN0MjRocnMiLCAicmVsYXRpdmVfaHVtaWRpdHkiLCAidGltZSIsICJzbndfZHB0aCIsICJuZXR3b3JrX25hbWUiLCAibmF0aXZlX2lkIiwgInN0YXRpb25fbmFtZSIsICJsb24iLCAibGF0IiwgImVsZXYiLCAibWluX29ic190aW1lIiwgIm1heF9vYnNfdGltZSIsICJmcmVxIiwgInByb3ZpbmNlIiwgInN0YXRpb25faWQiLCAiaGlzdG9yeV9pZCIsICJkZXNjcmlwdGlvbiIsICJuZXR3b3JrX2lkIiwgImNvbF9oZXgiLCJ2YXJzIiwiZGlzcGxheV9uYW1lcyIpICAgICAKCnN0YXRpb25GaWxlcyA8LSBsaXN0LmZpbGVzKHBhdGg9TkVUV09SSywgcGF0dGVybj0iKi5hc2NpaSIsIGZ1bGwubmFtZXM9RkFMU0UsIHJlY3Vyc2l2ZT1GQUxTRSkKCmxpc3Rfb2Zfc3RhdGlvbl9kZiA8LSBsYXBwbHkoc3RhdGlvbkZpbGVzLCBmdW5jdGlvbihmaWxlTmFtZSkgewogIAogIHN0YXRpb25fZGYgPC0gcmVhZC5jc3YoZmlsZSA9IHBhc3RlKE5FVFdPUkssIGZpbGVOYW1lLCBzZXA9Ii8iKSwgc2VwPScsJywgc3RyaXAud2hpdGU9VFJVRSwgc2tpcCA9IDEpCiAgc3RhdGlvbl9pZCA8LSBnc3ViKCIqLmFzY2lpIiwgIiIsIGZpbGVOYW1lKQogIAogIHN0YXRpb25fbWV0YV9kYXRhX2hlYWRlcnMgPSBuYW1lcyhzdGF0aW9uX21ldGFfZGF0YVtbc3RhdGlvbl9pZF1dKQogIAogIAogICMgQWRkIG1ldGEgZGF0YSB0byBldmVyeSByb3cgaW4gc3RhdGlvbl9kZgogIGZvcihoZWFkZXIgaW4gc3RhdGlvbl9tZXRhX2RhdGFfaGVhZGVycykgewogICAgc3RhdGlvbl9kZlssaGVhZGVyXSA8LSBjKHJlcChzdGF0aW9uX21ldGFfZGF0YVtbc3RhdGlvbl9pZF1dW1toZWFkZXJdXSwgbnJvdyhzdGF0aW9uX2RmKSkpCgogIH0KICAKICAjIEFkZCBoZWFkZXJzIGlmIHRoZXkgZG9uJ3QgZXhpc3QsIHNvIGFsbCBkZidzIGhhdmUgc2FtZSBoZWFkZXJzCiAgc3RhdGlvbl9kZlthbGxfaGVhZGVyc1shKGFsbF9oZWFkZXJzICVpbiUgY29sbmFtZXMoc3RhdGlvbl9kZikpXV0gPSBOQQogIAogICMgRGVsZXRlIHVzZWxlc3MgY29sdW1ucwogIHN0YXRpb25fZGYkZGlzcGxheV9uYW1lcyA8LSBOVUxMCiAgc3RhdGlvbl9kZiR2YXJzIDwtIE5VTEwKCiAgIyBDb252ZXJ0IHRoZXNlIGNvbHVtbnMgdG8gbnVtZXJpYyB0eXBlCiAgc3RhdGlvbl9kZiR3aW5kX2RpcmVjdGlvbiA9IGFzLm51bWVyaWMoc3RhdGlvbl9kZiR3aW5kX2RpcmVjdGlvbikKICBzdGF0aW9uX2RmJHJlbF9odW0gPSBhcy5udW1lcmljKHN0YXRpb25fZGYkcmVsX2h1bSkKICBzdGF0aW9uX2RmJHByZWNpcGl0YXRpb24gPSBhcy5udW1lcmljKHN0YXRpb25fZGYkcHJlY2lwaXRhdGlvbikKICBzdGF0aW9uX2RmJHdpbmRfc3BlZWQgPSBhcy5udW1lcmljKHN0YXRpb25fZGYkd2luZF9zcGVlZCkKICBzdGF0aW9uX2RmJHRlbXBlcmF0dXJlID0gYXMubnVtZXJpYyhzdGF0aW9uX2RmJHRlbXBlcmF0dXJlKQogIHN0YXRpb25fZGYkYXZnX3duZF9kaXJfMTBtX3BzdDEwbXRzID0gYXMubnVtZXJpYyhzdGF0aW9uX2RmJGF2Z193bmRfZGlyXzEwbV9wc3QxMG10cykKICBzdGF0aW9uX2RmJHJlbGF0aXZlX2h1bWlkaXR5ID0gYXMubnVtZXJpYyhzdGF0aW9uX2RmJHJlbGF0aXZlX2h1bWlkaXR5KQogIHN0YXRpb25fZGYkc253X2RwdGggPSBhcy5udW1lcmljKHN0YXRpb25fZGYkc253X2RwdGgpCiAgc3RhdGlvbl9kZiRsb24gPSBhcy5udW1lcmljKHN0YXRpb25fZGYkbG9uKQogIHN0YXRpb25fZGYkbGF0ID0gYXMubnVtZXJpYyhzdGF0aW9uX2RmJGxhdCkKICBzdGF0aW9uX2RmJGVsZXYgPSBhcy5udW1lcmljKHN0YXRpb25fZGYkZWxldikKICBzdGF0aW9uX2RmJGFpcl90ZW1wID0gYXMubnVtZXJpYyhzdGF0aW9uX2RmJGFpcl90ZW1wKQogIHN0YXRpb25fZGYkZHdwdF90ZW1wID0gYXMubnVtZXJpYyhzdGF0aW9uX2RmJGR3cHRfdGVtcCkKICBzdGF0aW9uX2RmJGZyZXEgPSBhcy5udW1lcmljKHN0YXRpb25fZGYkZnJlcSkKICBzdGF0aW9uX2RmJHJuZmxfYW10X3BzdDI0aHJzID0gYXMubnVtZXJpYyhzdGF0aW9uX2RmJHJuZmxfYW10X3BzdDI0aHJzKQogICMgdGF0aW9uX2RmJHRpbWUgPSBhcy5QT1NJWGN0KHN0YXRpb25fZGYkdGltZSkKICAKICAKICByZXR1cm4oc3RhdGlvbl9kZikKfSkKYGBgCgojIyMgQ29uZmlybSBkYXRhIHR5cGVzIGFyZSBhcHByb3ByaWF0ZQpgYGB7cn0KIyBDaGVjayB0eXBlcyBvZiBhbGwgY29sdW1ucyBpbiBhIGRhdGEgZnJhbWUKc2FwcGx5KGxpc3Rfb2Zfc3RhdGlvbl9kZltbNjddXSwgbW9kZSkKYGBgCgojIyMgSW5zcGVjdCBhIHNpbmdsZSB3ZWF0aGVyIHN0YXRpb24KCmBgYHtyfQoKIyBHZXQgdGhlIDFzdCBkZiAoZm9yIGV4YW1wbGUuLikKZGZfMSA9IGxpc3Rfb2Zfc3RhdGlvbl9kZltbMV1dCmBgYAojIyMgVmlzdWFsaXplIG1pc3NpbmcgZGF0YSBmb3IgcmVsZXZlbnQgdmFyaWFibGVzIApgYGB7cn0KZGZfMV9yZWxldmFudCA9IGRmXzFbLCBjKCJ3aW5kX3NwZWVkIiwgInJlbF9odW0iLCAicHJlY2lwaXRhdGlvbiIsICJyZWxhdGl2ZV9odW1pZGl0eSIsICJ3aW5kX2RpcmVjdGlvbiIsICJ0ZW1wZXJhdHVyZSIsICJhaXJfdGVtcCIsICJ0aW1lIildCgpnZ19taXNzX3ZhcihkZl8xX3JlbGV2YW50KQoKYGBgCiMjIyBIZWF0IE1hcAoKYGBge3J9CgojIENyZWF0ZSBkZiBmb3IgaGVhdCBtYXAKZGZfaGVhdG1hcCA8LSBkYXRhLmZyYW1lKG1hdHJpeChuY29sID0gMCwgbnJvdyA9IG5yb3coZGZfMSkpKQpkZl9oZWF0bWFwJHN0YXRpb25pZCA8LSBkZl8xJHN0YXRpb25faWQKZGZfaGVhdG1hcCRkYXkgPC0gZGF5KGFzLlBPU0lYY3QoZGZfMSR0aW1lKSkKZGZfaGVhdG1hcCRob3VyIDwtIGhvdXIoYXMuUE9TSVhjdChkZl8xJHRpbWUpKQpkZl9oZWF0bWFwJG1vbnRoIDwtIG1vbnRoKGFzLlBPU0lYY3QoZGZfMSR0aW1lKSkKZGZfaGVhdG1hcCR5ZWFyIDwtIHllYXIoYXMuUE9TSVhjdChkZl8xJHRpbWUpKQpkZl9oZWF0bWFwJHRlbXAgPC0gZGZfMSR0ZW1wZXJhdHVyZQoKI3NhcHBseShkZl9oZWF0bWFwLCBtb2RlKQoKIyBPbmx5IHVzZSByb3dzIGZvciB5ZWFyIDIwMjAKZGZfaGVhdG1hcCA8LSBkZl9oZWF0bWFwW2RmX2hlYXRtYXAkeWVhciA9PSAyMDIwLF0KYGBgCgoKCmBgYHtyfQoKCiMgTG9vayBpbnRvIG1vcmUgc3BlY2lhbGlzdCB3YXkgb2YgcmVwbGFjaW5nIHRoZXNlIG1pc3NpbmcgdmFsdWVzIC1lLmcuIGltcHV0YXRpb24gb3IgSURXIGludGVycG9sYXRpb24KIApkZiA8LSBkZl9oZWF0bWFwCgpzdGF0bm8gPC11bmlxdWUoZGYkc3RhdGlvbmlkKQogCiMjIyMjIyMjIFBsb3R0aW5nIHN0YXJ0cyBoZXJlIyMjIyMjIyMjIyMjIyMjIyMjIyMjCnAgPC1nZ3Bsb3QoZGYsYWVzKGRheSxob3VyLGZpbGw9dGVtcCkpKwogIGdlb21fdGlsZShjb2xvcj0gIndoaXRlIixzaXplPTAuMSkgKyAKICBzY2FsZV9maWxsX3ZpcmlkaXMobmFtZT0iSHJseSBUZW1wcyBDIixvcHRpb24gPSJDIikKcCA8LXAgKyBmYWNldF9ncmlkKHllYXJ+bW9udGgpCnAgPC1wICsgc2NhbGVfeV9jb250aW51b3VzKHRyYW5zID0gInJldmVyc2UiLCBicmVha3MgPSB1bmlxdWUoZGYkaG91cikpCnAgPC1wICsgc2NhbGVfeF9jb250aW51b3VzKGJyZWFrcyA9YygxLDEwLDIwLDMxKSkKcCA8LXAgKyB0aGVtZV9taW5pbWFsKGJhc2Vfc2l6ZSA9IDgpCnAgPC1wICsgbGFicyh0aXRsZT0gcGFzdGUoIkhvdXJseSBUZW1wcyAtIFN0YXRpb24iLHN0YXRubyksIHg9IkRheSIsIHk9IkhvdXIgQ29tbWVuY2luZyIpCnAgPC1wICsgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gImJvdHRvbSIpKwogIHRoZW1lKHBsb3QudGl0bGU9ZWxlbWVudF90ZXh0KHNpemUgPSAxNCkpKwogIHRoZW1lKGF4aXMudGV4dC55PWVsZW1lbnRfdGV4dChzaXplPTYpKSArCiAgdGhlbWUoc3RyaXAuYmFja2dyb3VuZCA9IGVsZW1lbnRfcmVjdChjb2xvdXI9IndoaXRlIikpKwogIHRoZW1lKHBsb3QudGl0bGU9ZWxlbWVudF90ZXh0KGhqdXN0PTApKSsKICB0aGVtZShheGlzLnRpY2tzPWVsZW1lbnRfYmxhbmsoKSkrCiAgdGhlbWUoYXhpcy50ZXh0PWVsZW1lbnRfdGV4dChzaXplPTcpKSsKICB0aGVtZShsZWdlbmQudGl0bGU9ZWxlbWVudF90ZXh0KHNpemU9OCkpKwogIHRoZW1lKGxlZ2VuZC50ZXh0PWVsZW1lbnRfdGV4dChzaXplPTYpKSsKICByZW1vdmVHcmlkKCkjZ2dFeHRyYQogCiMgeW91IHdpbGwgd2FudCB0byBleHBhbmQgeW91ciBwbG90IHNjcmVlbiBiZWZvcmUgdGhpcyBiaXQhCnAgI2F3ZXNvbWVuZXNzCmBgYAojIyMgVGltZSBTZXJpZXMKCmBgYHtyfQp0ZW1wX2RmXzEgPC0gZGF0YS5mcmFtZSgKICBkYXkgPSBhcy5QT1NJWGN0KGRmXzEkdGltZSksCiAgdmFsdWUgPSBkZl8xJHRlbXBlcmF0dXJlCikKCnJlbF9odW1fZGZfMSA8LSBkYXRhLmZyYW1lKAogIGRheSA9IGFzLlBPU0lYY3QoZGZfMSR0aW1lKSwKICB2YWx1ZSA9IGRmXzEkcmVsYXRpdmVfaHVtaWRpdHkKKQoKcHJlY2lwX2RmXzEgPC0gZGF0YS5mcmFtZSgKICBkYXkgPSBhcy5QT1NJWGN0KGRmXzEkdGltZSksCiAgdmFsdWUgPSBkZl8xJHByZWNpcGl0YXRpb24KKQoKYGBgCgoKYGBge3J9CiMgTGlicmFyaWVzCmxpYnJhcnkoZ2dwbG90MikKbGlicmFyeShkcGx5cikKbGlicmFyeShocmJydGhlbWVzKQoKIyAjIER1bW15IGRhdGEKIyBkYXRhIDwtIGRhdGEuZnJhbWUoCiMgICBkYXkgPSBkZl8xJHRpbWUsCiMgICB2YWx1ZSA9IGRmXzEkdGVtcGVyYXR1cmUKIyApCgpjcmVhdGVUaW1lU2VyaWVzIDwtIGZ1bmN0aW9uIChkYXRhLCB5X2xhYikgewoKICAjIE1vc3QgIHBsb3QKICBwIDwtIGdncGxvdChkYXRhLCBhZXMoeD1kYXksIHk9dmFsdWUsIGdyb3VwID0gMSkpICsKICAgIGdlb21fbGluZShjb2xvcj0ic3RlZWxibHVlIikgKwogICAgZ2VvbV9zbW9vdGgobWV0aG9kPSJhdXRvIiwgc2U9VFJVRSwgZnVsbHJhbmdlPUZBTFNFLCBsZXZlbD0wLjk1LCBjb2xvcj0iZ3JleSIpICsKICAgIHhsYWIoIiIpICsKICAgIHlsYWIoeV9sYWIpICsKICAgIHRoZW1lX2lwc3VtKCkgKwogICAgdGhlbWUoYXhpcy50ZXh0Lng9ZWxlbWVudF90ZXh0KGFuZ2xlPTYwLCBoanVzdD0xKSkKICAKICBwIDwtIGdncGxvdGx5KHApCiAgCiAgcAp9CgpgYGAKCmBgYHtyfQpjcmVhdGVUaW1lU2VyaWVzKHRlbXBfZGZfMSwgIlRlbXBlcmF0dXJlIikKCmBgYAoKYGBge3J9CmNyZWF0ZVRpbWVTZXJpZXMocmVsX2h1bV9kZl8xLCAiUmVsYXRpdmUgSHVtaWRpdHkiKQpgYGAKCmBgYHtyfQpjcmVhdGVUaW1lU2VyaWVzKHByZWNpcF9kZl8xLCAiUHJlY2lwaXRhdGlvbiIpCgpgYGAKCmBgYHtyfQojIEdldCBtaW4gYW5kIG1heCByZWxfaHVtCm1heF9yZWxfaHVtID0gbWF4KGRmXzEkcmVsX2h1bSwgbmEucm0gPSBUUlVFKQptaW5fcmVsX2h1bSA9IG1pbihkZl8xJHJlbF9odW0sIG5hLnJtID0gVFJVRSkKCm1pbl90aW1lID0gbWluKGRmXzEkdGltZSwgbmEucm0gPSBUUlVFKQptYXhfdGltZSA9IG1heChkZl8xJHRpbWUsIG5hLnJtID0gVFJVRSkKCiMgR2V0IHRoZSBtaW4gYW5kIG1heCB0aW1lIG9mIGFsbCB0aGUgZGF0YQptaW5fdGltZV9hbGwgPSBtaW4odW5saXN0KGxhcHBseShsaXN0X29mX3N0YXRpb25fZGYsIGZ1bmN0aW9uKGRmKSB7CiAgcmV0dXJuKG1pbihkZiR0aW1lLCBuYS5ybSA9IFRSVUUpKQp9KSkpCgptYXhfdGltZV9hbGwgPSBtYXgodW5saXN0KGxhcHBseShsaXN0X29mX3N0YXRpb25fZGYsIGZ1bmN0aW9uKGRmKSB7CiAgcmV0dXJuKG1heChkZiR0aW1lLCBuYS5ybSA9IFRSVUUpKQp9KSkpCgpwcmludChtaW5fdGltZV9hbGwpCnByaW50KG1heF90aW1lX2FsbCkKCnByaW50KGFzLlBPU0lYY3QobWluX3RpbWVfYWxsKSkKcHJpbnQoYXMuUE9TSVhjdChtYXhfdGltZV9hbGwpKQpgYGAKCiMjIyBHZW5lcmF0ZSBsaXN0IG9mIGhvdXJzIGJldHdlZW4gbWluIGFuZCBtYXggdGltZSAKCmBgYHtyfQp0aW1lX3JhbmdlX2hvdXJzIDwtIHNlcShhcy5QT1NJWGN0KG1pbl90aW1lX2FsbCksIGFzLlBPU0lYY3QobWF4X3RpbWVfYWxsKSwgYnk9ImhvdXIiKQp0aW1lX3JhbmdlX2hvdXJzIDwtIGxhcHBseSh0aW1lX3JhbmdlX2hvdXJzLCBmdW5jdGlvbihob3VyKSBhcy5QT1NJWGN0KGhvdXIsIGZvcm1hdD0iJWQtJWItJVkgJUg6JU06JU9TIikpCiNwcmludCh0aW1lX3JhbmdlX2hvdXJzWzE6Ml0pCiNwcmludCh0eXBlb2YodGltZV9yYW5nZV9ob3Vyc1tbMV1dKSkKI3ByaW50KGFzLmNoYXJhY3Rlcih0aW1lX3JhbmdlX2hvdXJzW1tsZW5ndGgodGltZV9yYW5nZV9ob3VycyldXSkpCnByaW50KHRpbWVfcmFuZ2VfaG91cnNbMTozXSkKCmBgYAoKCiMjIyBDcmVhdGUgbGlzdCBvZiBkZidzIGZvciBldmVyeSBob3VyCgoKYGBge3J9Cmxpc3Rfb2ZfaG91cmx5X3N0YXRpb25fZGYgPSBsaXN0KCkKCmZvcih0aW1lIGluIHRpbWVfcmFuZ2VfaG91cnMpIHsKICBkZiA8LSBkYXRhLmZyYW1lKG1hdHJpeChuY29sID0gbGVuZ3RoKGFsbF9oZWFkZXJzKSwgbnJvdyA9IDApKQogIGNvbG5hbWVzKGRmKSA8LSBhbGxfaGVhZGVycwogIAogIGxpc3Rfb2ZfaG91cmx5X3N0YXRpb25fZGZbW2FzLmNoYXJhY3Rlcih0aW1lKV1dID0gZGYKCn0KCgpgYGAKCgpgYGB7cn0KZm9yKHN0YXRpb25fZGYgaW4gbGlzdF9vZl9zdGF0aW9uX2RmWzFdKSB7CiAgCiAgZm9yIChyb3dOdW0gaW4gMTpucm93KHN0YXRpb25fZGYpKSB7CiAgCiAgICB0aW1lIDwtIGFzLlBPU0lYY3Qoc3RhdGlvbl9kZltyb3dOdW0sICJ0aW1lIl0pCiAgICBob3VyX2RmID0gbGlzdF9vZl9ob3VybHlfc3RhdGlvbl9kZltbYXMuY2hhcmFjdGVyKHRpbWUpXV0KICAgIAogICAgI2xpc3Rfb2ZfaG91cmx5X3N0YXRpb25fZGZbW2FzLmNoYXJhY3Rlcih0aW1lKV1dID0gcmJpbmQoaG91cl9kZiwgc3RhdGlvbl9kZltyb3dOdW0sXSkKICAgIAogICAgcHJpbnQoc3RhdGlvbl9kZltyb3dOdW0sXSkKICAgIAogICAgaG91cl9kZltucm93KGhvdXJfZGYpICsgMSxdID0gc3RhdGlvbl9kZltyb3dOdW0sXSAgICAKICAgIGxpc3Rfb2ZfaG91cmx5X3N0YXRpb25fZGZbW2FzLmNoYXJhY3Rlcih0aW1lKV1dID0gaG91cl9kZgoKCiAgfQp9CmBgYAoKCg==